external hash_param : int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc";

value hash x = hash_param 10 100 x;

type t 'a 'b = 
  {
    size: mutable int;
    data: mutable array (h_bucketlist 'a 'b)
  }
and h_bucketlist 'a 'b =
  [ Empty 
  | Cons of 'a and HSet.t 'b and  (h_bucketlist 'a 'b)
  ];

value create initial_size =
  let s = min (max 1 initial_size) Sys.max_array_length in
  { size = 0; data = Array.make s Empty };

value empty () = { size = 0; data = Array.make 1 Empty };

value clear h =
(
  for i = 0 to Array.length h.data - 1 do
    h.data.(i) := Empty
  done;
  h.size := 0;
);

value length h = h.size;

value resize hashfun tbl =
  let odata = tbl.data in
  let osize = Array.length odata in
  let nsize = min (2 * osize + 1) Sys.max_array_length in
  if nsize <> osize 
  then 
    let ndata = Array.create nsize Empty in
    let rec insert_bucket = fun
      [ Empty -> ()
      | Cons(key, data, rest) ->
        (
          insert_bucket rest; (* preserve original order of elements *)
          let nidx = (hashfun key) mod nsize in
          ndata.(nidx) := Cons(key, data, ndata.(nidx)) 
        )
      ]
    in
    (
      for i = 0 to osize - 1 do
        insert_bucket odata.(i)
      done;
      tbl.data := ndata;
    )
  else ();

value add h key data =
  let i = (hash key) mod (Array.length h.data) in
  match h.data.(i) with
  [ Empty -> 
    let bucket = Cons key (HSet.singleton data) Empty in
    (
      h.data.(i) := bucket;
      h.size := succ h.size;
      if h.size > Array.length h.data lsl 1 then resize hash h else ()
    )
  | Cons k d rest as b ->
      if k = key
      then 
      (
        HSet.add d data;
        h.size := succ h.size;
      )
      else
        let rec insert = fun
          [ Empty -> True
          | Cons k d rest -> 
              if k = key
              then
              (
                HSet.add d data;
                h.size := succ h.size;
                False
              )
              else insert rest
          ]
        in
        if insert rest
        then
          let bucket = Cons key (HSet.singleton data) b in
          (
            h.data.(i) := bucket;
            h.size := succ h.size;
            if h.size > Array.length h.data lsl 1 then resize hash h else ();
          )
        else ()
  ];

value rec find_rec key = fun
  [ Empty -> raise Not_found
  | Cons(k, d, rest) -> if key = k then d else find_rec key rest
  ];

value find h key =
  match h.data.((hash key) mod (Array.length h.data)) with
  [ Empty -> raise Not_found
  | Cons(k1, d1, rest1) ->
      if key = k1 then d1 else
      match rest1 with
      [ Empty -> raise Not_found
      | Cons(k2, d2, rest2) ->
          if key = k2 then d2 else
          match rest2 with
          [ Empty -> raise Not_found
          | Cons(k3, d3, rest3) -> if key = k3 then d3 else find_rec key rest3
          ]
      ]
  ];

value mem h key =
  let rec mem_in_bucket = fun
    [ Empty -> False
    | Cons (k, d, rest) -> k = key || mem_in_bucket rest
    ]
  in
  mem_in_bucket h.data.((hash key) mod (Array.length h.data));


value mem_val h key v = 
  try
    let vals = find h key in
    HSet.mem vals v
  with [ Not_found -> False ];

value remove h key =
  let rec remove_bucket = fun
    [ Empty -> Empty
    | Cons(k, i, next) ->
        if k = key
        then 
        (
          h.size := pred h.size; 
          next 
        )
        else Cons(k, i, remove_bucket next) 
    ]
  in
  let i = (hash key) mod (Array.length h.data) in
  h.data.(i) := remove_bucket h.data.(i);

value pop h key = 
  let pos = (hash key) mod (Array.length h.data) in
  let l = Array.unsafe_get h.data pos in
  match l with
  [ Empty -> raise Not_found
  | Cons (k,v,next) ->
      if k = key 
      then 
      (
        h.size := pred h.size;
        Array.unsafe_set h.data pos next;
        v
      )
      else 
        let rec loop = fun
         [ Empty -> raise Not_found
         | Cons (k,v,next) ->
            if k = key 
            then 
            (
              h.size := pred h.size;
              (v,next)
            )
            else 
              let (res,next) = loop next in
              (res,Cons(k,v,next))
         ]
        in
        let (res,next) = loop next in
        (
          Array.unsafe_set h.data pos (Cons(k,v,next));
          res 
        )
  ];

value remove_val h key v = 
  let rec remove_bucket = fun
    [ Empty -> Empty
    | Cons(k, i, next) as e ->
        if k = key
        then 
        (
          HSet.remove i v;
          if HSet.is_empty i 
          then
          (
            h.size := pred h.size; 
            next 
          )
          else e
        )
        else Cons(k, i, remove_bucket next) 
    ]
  in
  let i = (hash key) mod (Array.length h.data) in
  h.data.(i) := remove_bucket h.data.(i);

value iter f h =
  let rec do_bucket = fun
    [ Empty -> ()
    | Cons(k, d, rest) -> (f k d; do_bucket rest)
    ]
  in
  let d = h.data in
  for i = 0 to Array.length d - 1 do
    do_bucket d.(i)
  done;


value iter_vals f h k = 
  try
    HSet.iter f (find h k);
  with [ Not_found -> () ];
